home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload Trio 2
/
Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO
/
dir36
/
jump20.zip
/
JUMP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-10-18
|
3KB
|
114 lines
Program Jump20;
uses Dos, SetEnvir;
var
S : PathStr;
P : PathStr;
D : DirStr;
N : NameStr;
E : ExtStr;
path : string;
drive : string;
Err : word;
const
Note : string[55] =
' Compiled for the BatPower conference by David Adamson';
Procedure Error;
Begin
Writeln(' Error. Out of environment memory? Errorlevel exit: ',Err);
Halt(Err);
end;
Function ReadUpToFirstColon(s:String): String;
Var
i: Word;
tempo: String;
Begin
i := Pos(':',s);
If i <> 0
Then
ReadUpToFirstColon := Copy(s,1,i-1)
Else
Begin
ReadUpToFirstColon := ''; {Function should always return something}
End;
End;
Procedure Return;
var
OLDRV, OLDIR : string;
begin
OLDRV := GetEnv('OLDRV');
If OLDRV = '' then
begin
writeln(' Old drive not found in environment.');
Halt(2);
end;
OLDIR := GetEnv('OLDIR');
If OLDIR = '' then
begin
writeln(' Old directory not found in environment.');
Halt(2);
end;
delete(OLDIR, 1, 2);
{$I-}
ChDir(OLDRV + OLDIR);
{$I+}
If IOresult <> 0 then
begin
writeln(' Unable to change back to old path.');
Halt(2);
end;
Halt(0);
end;
(* ================= PROGRAM START =================================== *)
begin
if (paramStr(1) = 'R') or (paramStr(1) = 'r') then Return;
if (paramcount >1) or (paramStr(1) = '/?') or (paramStr(1) = '-?')
then
begin
writeln;
writeln(' This is a program to insert the current drive and path into');
writeln(' the environment. Enter JUMP to save the current drive/path.');
writeln(' Enter JUMP R to return to the original drive and path.');
end;
S := 'NUL';
if S = ''
then
Halt(1)
else
S := FExpand(S); {Find path for current dir by searching for "NUL"}
FSplit(S, D, N, E); {Split drive and path}
Path := D;
Drive := ReadUpToFirstColon(Path);
drive := drive + ':';
delete(Path,1,2); {Delete drive letter and colon}
delete(path,Length(path),1); {Delete trailing back slash}
if path = ''
then
path := '\';
path := 'CD' + path;
SetEnv('OLDRV',drive);
Err := IOresult;
if Err <> 0
then
Error;
SetEnv('OLDIR',path);
Err := IOresult;
if Err <> 0
then
Error;
writeln(' %OLDRV% set to ',drive,' and %OLDIR% set to ',path);
Halt(Err);
end.